home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / obj2str.scm < prev    next >
Text File  |  1999-04-19  |  2KB  |  65 lines
  1. ;;; "obj2str.scm", write objects to a string.
  2. ;Copyright (C) 1993, 1994 Aubrey Jaffer
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20. (require 'string-port)
  21.  
  22. ;;@body Returns the textual representation of @1 as a string.
  23. (define (object->string obj)
  24.   (cond ((symbol? obj) (symbol->string obj))
  25.     ((number? obj) (number->string obj))
  26.     (else
  27.      (call-with-output-string
  28.       (lambda (port) (write obj port))))))
  29.  
  30. ; File: "obj2str.scm"   (c) 1991, Marc Feeley
  31.  
  32. ;(require 'generic-write)
  33.  
  34. ; (object->string obj) returns the textual representation of 'obj' as a
  35. ; string.
  36. ;
  37. ; Note: (write obj) = (display (object->string obj))
  38.  
  39. ;(define (object->string obj)
  40. ;  (let ((result '()))
  41. ;    (generic-write obj #f #f (lambda (str) (set! result (cons str result)) #t))
  42. ;    (reverse-string-append result)))
  43.  
  44. ; (object->limited-string obj limit) returns a string containing the first
  45. ; 'limit' characters of the textual representation of 'obj'.
  46.  
  47. ;;@body Returns the textual representation of @1 as a string of length
  48. ;;at most @2.
  49. (define (object->limited-string obj limit)
  50.   (require 'generic-write)
  51.   (let ((result '()) (left limit))
  52.     (generic-write obj #f #f
  53.            (lambda (str)
  54.              (let ((len (string-length str)))
  55.                (if (> len left)
  56.                (begin
  57.                  (set! result (cons (substring str 0 left) result))
  58.                  (set! left 0)
  59.                  #f)
  60.                (begin
  61.                  (set! result (cons str result))
  62.                  (set! left (- left len))
  63.                  #t)))))
  64.     (reverse-string-append result)))
  65.